home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
v9n04.arc
/
POKER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-01-30
|
7KB
|
237 lines
UNIT Poker;
(**********************)
(**) INTERFACE (**)
(**********************)
USES Crt, Cards;
TYPE
Message = String[40];
PokerHand = (nothing, JacksOrBetter, TwoPair, ThreeOfAKind,
straight, flush, FullHouse, FourOfAKind,
StraightFlush, RoyalFlush);
PokerGame = OBJECT (game)
layout : array[0..4] of CardP;
Hold : array[0..4] of Boolean;
stake : LongInt;
margin, tab,
topmargin : word;
CONSTRUCTOR Init(iTC : Byte);
DESTRUCTOR Done; virtual;
FUNCTION NameScore(P : PokerHand) : String;
FUNCTION Analyze : PokerHand;
PROCEDURE Play(VAR again : boolean);
{--- output methods ---}
PROCEDURE AskForBet;
PROCEDURE TellHowToHold;
PROCEDURE TellWhatchaWon(S : Message);
PROCEDURE YouBusted;
PROCEDURE Display; virtual;
PROCEDURE ClearBottom; virtual;
PROCEDURE ShowStake; virtual;
PROCEDURE HoldButton(B : Byte); virtual;
PROCEDURE Tell(M1, M2 : Message); virtual;
END;
(**********************)
(**) IMPLEMENTATION (**)
(**********************)
CONST Payoff : ARRAY [PokerHand] OF byte =
(0, 1, 2, 3, 4, 6, 9, 25, 50, 250);
CONSTRUCTOR PokerGame.Init(iTC : byte);
BEGIN
Game.Init(iTC);
FillChar(layout, SizeOf(layout), 0);
stake := 40;
END;
DESTRUCTOR PokerGame.Done; BEGIN game.Done; END;
FUNCTION PokerGame.Analyze : PokerHand;
VAR
valu, suit : Array[0..4] of byte;
same1, same2,
N, M, P : Byte;
IsF, IsS : boolean; {IsFlush and IsStraight}
BEGIN
FOR N := 0 to 4 DO
BEGIN
valu[N] := layout[N]^.GetRank;
suit[N] := layout[N]^.GetSuit;
END;
{Sort the values into order}
FOR N := 4 DOWNTO 1 DO
FOR M := 0 to pred(N) DO
IF valu[M] > valu[N] THEN
BEGIN
P := valu[M]; valu[M] := valu[N]; valu[N] := P;
END;
IsF := true; IsS := true; {-- true 'til proven false --}
FOR M := 1 to 4 DO IF suit[M]<>suit[0] THEN IsF := false;
FOR N := 3 downto 1 DO IF valu[N+1]-valu[N]<>1 THEN IsS := false;
IF IsS THEN IsS := valu[1]-valu[0] IN [1, 9];
IF IsF THEN
BEGIN
IF IsS THEN
IF valu[1] = 10 THEN Analyze := RoyalFlush
ELSE Analyze := StraightFlush
ELSE Analyze := Flush;
EXIT;
END;
IF IsS THEN BEGIN Analyze := Straight; EXIT; END;
{-- no straight, no flush, try same-rank hands --}
same1 := 0; same2 := 0;
FOR N := 0 to 3 DO
IF valu[N] = valu[succ(N)] THEN
BEGIN
inc(same1);
P := valu[N];
END;
IF same1 > 0 THEN
FOR N := 0 to 4 DO IF valu[N] = P THEN Inc(same2);
CASE same1 OF
0 : Analyze := nothing;
1 : IF P IN [0, 10, 11, 12] THEN Analyze := JacksOrBetter
ELSE Analyze := Nothing;
2 : CASE same2 OF
2 : Analyze := TwoPair;
3 : Analyze := ThreeOfAKind;
END;
3 : CASE same2 OF
2, 3 : Analyze := FullHouse;
4 : Analyze := FourOfAKind;
END;
END;
END;
FUNCTION PokerGame.NameScore(P : PokerHand) : String;
BEGIN
CASE P OF
RoyalFlush : NameScore := 'Royal Flush!';
StraightFlush : NameScore := 'Straight Flush';
FourOfAKind : NameScore := 'Four of a kind';
Straight : NameScore := 'Straight';
FullHouse : NameScore := 'Full house';
ThreeOfAKind : NameScore := 'Three of a kind';
Flush : NameScore := 'Flush';
TwoPair : NameScore := 'Two pairs';
JacksOrBetter : NameScore := 'Jacks or better';
Nothing : NameScore := 'Nothing';
ELSE NameScore := 'HUH?????';
END;
END;
PROCEDURE PokerGame.Play(VAR again : boolean);
VAR CH : Char;
N, which : Byte;
TheHand : PokerHand;
CONST
NumCoins : Byte = 1;
BEGIN
D^.Shuffle;
Again := false;
FillChar(Hold, SizeOf(Hold), false);
FOR N := 0 to 4 DO {--lay out 5 cards face down --}
BEGIN
layout[N] := CardP(D^.FromTop);
WITH layout[N]^ DO
BEGIN PutInPlace(margin+N*tab, topmargin); display; END;
END;
ShowStake;
AskForBet;
REPEAT CH := ReadKey UNTIL CH IN ['1'..'5', ' ', #27];
CASE CH OF
#27 : Exit;
' ' : ; {space bets same as last time}
ELSE NumCoins := ord(CH)-ord('0');
END;
Dec(stake, NumCoins);
ShowStake; {-- bet 1-5 quarters --}
ClearBottom;
TellHowToHold;
FOR N := 0 to 4 DO {-- turn up the cards --}
BEGIN
WITH layout[N]^ DO BEGIN TurnUp; Display; END;
click; delay(200);
END;
which := 0;
REPEAT {-- see which ones to HOLD --}
layout[which]^.PointT(dn);
CH := ReadKey;
layout[which]^.UnPoin(dn);
CASE CH OF
#0 : CASE ReadKey OF
#$4D : which := (which+1) MOD 5;
#$4B : which := (which+4) MOD 5;
END;
#32 : BEGIN
Hold[which] := NOT Hold[which];
HoldButton(which);
END;
END;
UNTIL CH = #13;
ClearBottom;
FOR N := 0 to 4 DO {-- deal new cards --}
IF NOT Hold[N] THEN
BEGIN
WITH layout[N]^ DO BEGIN TurnDown; Display; END;
click; delay(200);
D^.AddToBottom(Layout[N]);
END;
FOR N := 0 to 4 DO
IF NOT Hold[N] THEN
BEGIN
layout[N] := CardP(D^.FromTop);
WITH layout[N]^ DO
BEGIN
TurnUp; PutInPlace(margin+N*tab, topmargin); Display;
END;
click; delay(200);
END
ELSE BEGIN Hold[N] := false; HoldButton(N); END;
theHand := Analyze;
TellWhatchaWon(nameScore(theHand)); {-- what did you win? --}
Inc(stake, Word(NumCoins)*PayOff[theHand]);
ShowStake;
IF ReadKey = #0 THEN;
ClearBottom;
FOR N := 0 to 4 DO {-- put the cards back in the deck --}
BEGIN
WITH layout[N]^ DO BEGIN TurnDown; Hide; END;
D^.AddCard(layout[N]);
END;
IF stake <= 0 THEN
BEGIN
YouBusted;
IF ReadKey = #0 THEN;
Exit;
END;
again := true;
END;
PROCEDURE PokerGame.TellWhatchaWon(S : Message);
BEGIN Tell(S, ''); END;
PROCEDURE PokerGame.YouBusted;
BEGIN Tell('Sorry, friend, you''re busted!', ''); END;
PROCEDURE PokerGame.AskForBet;
BEGIN Tell('Play 1 to 5 quarters', 'Press <Esc> to quit'); END;
PROCEDURE PokerGame.TellHowToHold;
BEGIN
Tell('SPACEBAR turns HOLD on/off', 'ENTER when ready to draw');
END;
{--- output methods -- abstract ---}
PROCEDURE PokerGame.Display; BEGIN END;
PROCEDURE PokerGame.ClearBottom; BEGIN END;
PROCEDURE PokerGame.ShowStake; BEGIN END;
PROCEDURE PokerGame.HoldButton(B : Byte); BEGIN END;
PROCEDURE PokerGame.Tell(M1, M2 : Message); BEGIN END;
END.